home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / xlibpas.zip / DEMO5.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-19  |  4KB  |  121 lines
  1. {*************************************************************************
  2.  
  3. DEMO 5
  4.  
  5. Demonstrates Planar Bitmap Clipping Functions
  6.  
  7. C Version : Themie Gouthas - Pascal Version : Tristan Tarrant
  8. **************************************************************************}
  9. Program Demo5;
  10.  
  11. Uses
  12.     Crt, Xlib;
  13. Const
  14.     turtle : array[0..601] of byte = (
  15.         20,30,
  16.         8,14, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  17.         8, 2,14, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  18.         8, 2, 2, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  19.         8, 0, 2,14, 0, 0,14,14,14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  20.         8, 0, 2, 5, 0, 4, 4, 4, 4,14,14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  21.         8, 0, 2, 2, 4, 4, 0, 4, 4, 0, 4,14, 0, 0, 0, 0, 0, 0, 0, 0,
  22.         0, 0, 2, 4, 4, 4, 0, 4, 4, 0, 4, 4,14, 0, 0, 0, 0, 0, 0, 0,
  23.         0, 0, 2, 4, 4, 4, 0, 0, 0, 0, 4, 4,14, 0, 0, 0, 0, 0, 0, 0,
  24.         0, 0, 0, 0, 4, 0, 4, 4, 4, 0, 0, 0, 4, 0, 0, 2, 2, 0, 0, 0,
  25.         0, 0, 0, 4, 0, 4, 4, 4, 0, 4, 4, 4, 0,14, 0, 0, 2, 2, 0, 0,
  26.         0, 0, 0, 4, 4, 0, 0, 0, 4, 4, 0, 4, 0, 4, 2, 2, 2, 2, 0, 0,
  27.         0, 0, 0, 4, 4, 4, 0, 4, 4, 0, 4, 4, 0, 4,14, 2, 2, 2, 0, 0,
  28.         0, 0, 0, 4, 4, 4, 0, 0, 0, 4, 4, 0, 4, 0, 0, 2, 2, 0, 0, 0,
  29.         0, 0, 0, 2, 4, 4, 4, 4, 4, 4, 4, 0, 4, 4,14, 2, 0, 0, 0, 0,
  30.         0, 0, 2, 2, 0, 4, 4, 4, 4, 0, 0, 4, 4, 4, 4, 0, 0, 0, 0, 0,
  31.         2, 2, 2, 2, 4, 0, 0, 4, 4, 0, 4, 4, 0, 4,14, 0, 0, 0, 0, 0,
  32.         0, 2, 2, 0, 4, 4, 4, 0, 0, 4, 4, 0, 4, 0, 2, 0, 0, 0, 0, 0,
  33.         0, 0, 0, 0, 0, 4, 4, 0, 4, 4, 4, 0, 4, 4, 2,14, 0, 0, 0, 0,
  34.         0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 0, 4, 0, 2, 2,14,14, 0, 0,
  35.         0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 4, 4, 2, 2, 2, 2, 2,14, 0,
  36.         0, 0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 2, 2, 2, 2, 2, 5,14, 0,
  37.         0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 2, 2, 0, 0, 2, 2, 2, 0, 2,14,
  38.         0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 2, 2, 2,14,
  39.         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 2, 2, 2,
  40.         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 2, 0,
  41.         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0,
  42.         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0,
  43.         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0,
  44.         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0,
  45.         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  46.         );
  47.  
  48. Var
  49.     i,j : integer;
  50.     vbm : pointer;
  51.  
  52. procedure error( s : string );
  53. begin
  54.     xtextmode;
  55.     writeln( s );
  56.     halt(0);
  57. end;
  58.  
  59. Type
  60.     AlignmentHeader = record
  61.         size : word;
  62.         ImageWidth, ImageHeight : byte;
  63.         ImagePtr, MaskPtr : word;
  64.     end;
  65.  
  66. procedure main;
  67. var
  68.     i,j,k,handle,size,compsize : integer;
  69.     bm : pointer;
  70.     tempbuff : AlignmentHeader;
  71. begin
  72.     xsetmode(XMODE360x240,360);
  73.     xtextinit;
  74.     xsetfont(1);
  75.     xprintf(0,0,0,14,'This is a demo of PBM clipping.');
  76.     readkey;
  77.     getmem(bm,602);
  78.     xbmtopbm(turtle,bm^);
  79.     xsetcliprect(4,5,50,150);
  80.     xline(0,TopClip-1,320,TopClip-1,23,0);
  81.     xline(0,BottomClip+1,320,BottomClip+1,23,0);
  82.     xline(LeftClip shl 2-1,0,LeftClip shl 2-1,200,23,0);
  83.     xline(RightClip shl 2+4,0,RightClip shl 2+4,200,23,0);
  84.     for k:=0 to 7 do
  85.         for j:=1 to (ScrnPhysicalHeight-1) div 30 do
  86.             for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
  87.                 xputpbm(i*20+k+1,(j-1)*30,0,bm^);
  88.  
  89.     xline(0,TopClip-1,320,TopClip-1,23,0);
  90.     xline(0,BottomClip+1,320,BottomClip+1,23,0);
  91.     xline(LeftClip shl 2-1,0,LeftClip shl 2-1,200,23,0);
  92.     xline(RightClip shl 2+4,0,RightClip shl 2+4,200,23,0);
  93.     xrectfill(LeftClip shl 2,TopClip,RightClip shl 2+3,BottomClip,0,0);
  94.     xprintf(0,BottomClip+4,0,14,' Now the clipping...');
  95.     readkey;
  96.     for k:=0 to 7 do
  97.         for j:=1 to (ScrnPhysicalHeight-1) div 30 do
  98.             for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
  99.                 xputpbmclipxy(i*20+k+1,(j-1)*30,0,bm^);
  100.     for k:=0 to 7 do
  101.         for j:=1 to (ScrnPhysicalHeight-1) div 30 do
  102.             for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
  103.                 xputpbmclipxy(i*20+7+1,(j-1)*30+k,0,bm^);
  104.     for k:=0 to 7 do
  105.         for j:=1 to (ScrnPhysicalHeight-1) div 30 do
  106.             for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
  107.                 xputpbmclipxy(i*20+k+1,(j-1)*30+7,0,bm^);
  108.     for k:=0 to 7 do
  109.         for j:=1 to (ScrnPhysicalHeight-1) div 30 do
  110.             for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
  111.                 xputpbmclipxy(i*20+1,(j-1)*30+k,0,bm^);
  112.  
  113.     readkey;
  114.     xtextmode;
  115.     writeln(LeftClip,TopClip,RightClip,BottomClip);
  116.  
  117. end;
  118.  
  119. begin
  120.     main;
  121. end.